home *** CD-ROM | disk | FTP | other *** search
/ Programmer Plus 2007 / Programmer-Plus-2007.iso / Programming / Low Level Languages / FORTRAN.500 / DISK6 / HORIZON.FO$ / HORIZON.bin
Encoding:
Text File  |  1989-01-19  |  2.0 KB  |  64 lines
  1. CC  HORIZON.FOR - Illustrates VGA graphics with cycling of 256 colors.
  2.  
  3.       INCLUDE  'FGRAPH.FI'
  4.       INCLUDE  'FGRAPH.FD'
  5.  
  6.       INTEGER*2   MYRED, MYBLU, MYWHT, STEP
  7.       PARAMETER ( MYRED = #000003FF )
  8.       PARAMETER ( MYBLU = #003F0000 )
  9.       PARAMETER ( MYWHT = #003F3F3F )
  10.       PARAMETER ( STEP  = 21 )
  11.  
  12.       INTEGER*2        dummy, i, j
  13.       INTEGER*4        rainbow(0:511), col, ngray
  14.       RECORD /rccoord/ curpos
  15.       RECORD /xycoord/ xy
  16.  
  17. C
  18. C     Check to see if adapter can handle 256 colors.
  19. C
  20.       IF( setvideomode( $MRES256COLOR ) .EQ. 0 )
  21.      +    STOP 'This program requires a VGA card.' 
  22. C
  23. C     Create the colors.
  24. C
  25.       DO col = 0, 63
  26.          ngray = (col .OR. ISHFT( col,8 )) .OR. ISHFT( col,16 )
  27.          rainbow(col)             = MYBLU .AND. ngray
  28.          rainbow(col + 256)       = rainbow(col)
  29.          rainbow(col + 64)        = MYBLU .OR. ngray
  30.          rainbow(col + 64 + 256)  = rainbow(col + 64)
  31.          rainbow(col + 128)       = MYRED .OR.
  32.      +                            ( MYWHT .AND. .NOT. ngray )
  33.          rainbow(col + 128 + 256) = rainbow( 64 + 128)
  34.          rainbow(col + 192)       = MYRED .AND. .NOT. ngray
  35.          rainbow(col + 192 + 256) = rainbow(col + 192)
  36.       END DO
  37.       CALL setvieworg( 160, 85, xy )
  38. C
  39. C     Draw shapes on screen.
  40. C
  41.       DO i = 0, 254
  42.          dummy = setcolor( INT4( 255 - i ) )
  43.          CALL    moveto(  i, i - 255, xy )
  44.          dummy = lineto( -i, 255 - i )
  45.          CALL    moveto( -i, i - 255, xy )
  46.          dummy = lineto(  i, 255 - i )
  47.          dummy = ellipse( $GBORDER, -i, -i / 2, i, i / 2 )
  48.       END DO
  49. C
  50. C     Cycle through the colors.
  51. C
  52.       i = 0
  53.       DO j = 1, 256
  54.          dummy = remapallpalette( rainbow(i) )
  55.          i     = MOD( i + STEP, 256 )
  56.       END DO
  57.  
  58.       dummy = settextcolor( 15 )
  59.       CALL settextposition( 25, 1, curpos )
  60.       CALL outtext( 'Press ENTER to exit' )
  61.       READ (*,*)
  62.       dummy = setvideomode( $DEFAULTMODE ) 
  63.       END
  64.